home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form frmClipPrt
- BorderStyle = 1 'Fixed Single
- Caption = "Clipboard Printer"
- ClientHeight = 0
- ClientLeft = 2820
- ClientTop = 4860
- ClientWidth = 2460
- ClipControls = 0 'False
- Height = 690
- Icon = CLIPPRNT.FRX:0000
- Left = 2760
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 0
- ScaleWidth = 2460
- Top = 4230
- Width = 2580
- Begin Menu mnuPrint
- Caption = "&Print!"
- End
- Begin Menu mnuAbout
- Caption = "&About!"
- End
- Option Explicit
- 'Margin values
- Const MARGIN_LEFT = 0
- Const MARGIN_RIGHT = 0
- Const MARGIN_TOP = 0
- Const MARGIN_BOTTOM = 0
- Sub Form_Load ()
- 'Centre the Form on the Screen
- Move (screen.Width / 2) - (Width / 2), (screen.Height / 2) - (Height / 2)
- End Sub
- Sub mnuAbout_Click ()
- frmAbout.Show 1 ' Modal
- End Sub
- Sub mnuPrint_Click ()
- screen.MousePointer = 11 ' Hourglass
- If Clipboard.GetFormat(2) Or Clipboard.GetFormat(3) Or Clipboard.GetFormat(8) Then
- 'We have a picture ( either a Metafile WMF or a Bitmap BMP/DIB )
- Load frmBkground
- 'put the clipboard picutre on the form itself
- frmBkground.Picture = Clipboard.GetData()
- 'Show the Form (note that the form will be maximized
- frmBkground.Show
- ' Let Windows catch up
- DoEvents
- ' ... and then print the form. easy eh?
- frmBkground.PrintForm
- Unload frmBkground
- ElseIf Clipboard.GetFormat(1) Then
- 'We have text
- PrintText Clipboard.GetText()
- Else
- 'No picture or Text to display ( Must be nothing or something strange )
- MsgBox "The clipboard does not contain a picture or text", 48, "Clipboard Printer"
- End If
- screen.MousePointer = 0 ' Default
- ' Let Windows catch up
- DoEvents
- End Sub
- '******************************************************
- '* Procedure : PrintText
- '*-----------------------------------------------------
- '* Parameters : text
- '*-----------------------------------------------------
- '* Returns : none
- '*-----------------------------------------------------
- '* Prints a piece of text to the printer with headers
- '* footers, margins and full word wrap.
- '******************************************************
- Sub PrintText (text As String)
- Dim i As Integer, j As Integer, currWord As String
- i = 1
- 'Print text, word-wrapping as we go
- Do Until i > Len(text)
- 'Get next word
- currWord = ""
- Do Until i > Len(text) Or Mid$(text, i, 1) <= " "
- currWord = currWord & Mid$(text, i, 1)
- i = i + 1
- Loop
- 'Check if word will fit on this line
- If (Printer.CurrentX + Printer.TextWidth(currWord)) > (Printer.ScaleWidth - MARGIN_RIGHT) Then
- 'Send carriage-return line-feed to printer
- Printer.Print "" '& Chr$(187)
- 'Check if we need to start a new page
- If Printer.CurrentY > (Printer.ScaleHeight - MARGIN_BOTTOM) Then
- Printer.NewPage
- Printer.CurrentX = MARGIN_LEFT
- Printer.CurrentY = Printer.ScaleHeight - (MARGIN_BOTTOM / 2)
- Else
- Printer.CurrentX = MARGIN_LEFT
- End If
- End If
- 'Print this word
- Printer.Print currWord;
- 'Process whitespace and any control characters
- Do Until i > Len(text) Or Mid$(text, i, 1) > " "
- Select Case Mid$(text, i, 1)
- Case " " 'Space
- Printer.Print " ";
- Case Chr$(10) 'Line-feed
- 'Send carriage-return line-feed to printer
- Printer.Print
-
- 'Check if we need to start a new page
- If Printer.CurrentY > (Printer.ScaleHeight - MARGIN_BOTTOM) Then
- Printer.NewPage
- Printer.CurrentX = MARGIN_LEFT
- Printer.CurrentY = Printer.ScaleHeight - (MARGIN_BOTTOM / 2)
- Else
- Printer.CurrentX = MARGIN_LEFT
- End If
- Case Chr$(9) 'Tab
- j = (Printer.CurrentX - MARGIN_LEFT) / Printer.TextWidth("0")
- j = j + (10 - (j Mod 10))
- Printer.CurrentX = MARGIN_LEFT + (j * Printer.TextWidth("0"))
- Case Else 'Ignore other characters
- End Select
- i = i + 1
- Loop
- Loop
- Printer.EndDoc
- screen.MousePointer = 0 'Default
- End Sub
-